Practical Implementations of Principal Component Analysis

The Math behind PCA

Application 1 - Demographic Data

Dataset Description

This application was inspired by a paper published by UWF (Amin, Yacko, and Guttmann) on Alzheimer’s disease mortality (Tejada-Vera 2013) (Amin, Yacko, and Guttmann 2018).

The dataset is derived from US census data and contains demographic, health, and environmental metrics for counties in the United States. The dataset was filtered to select counties in the deep south.

Check Assumptions: Continuous Variables

• The variables appear to be continuous because the data types are “numeric” with high cardinality.
  
• There are no nulls.
  
• It is clear that scaling and mean-centering will be needed.

skim(data)

Check Assumptions: Linarity Analysis

The Harvey-Collier Test can automate this by running pairwise test for linearity, and if a significant nonzero slope on the residuals exists, the p-value will be less than alpha (Maureen, Oyinebifun, and Christopher 2022) (Harvey and Collier 1977).

Visually checking scatter plots is not a realistic method for inspecting linearity in real-world applications. Correlation plots are insufficient.

harvey_collier_test <- function(data, x, y) {
  formula <- as.formula(paste(y, "~", x))
  model <- lm(formula, data = data)
  test <- harvtest(model)
  p_value <- test$p.value
  return(signif(p_value, digits = 2))
}

variables <- names(data)
n <- length(variables)
p_matrix <- matrix(NA, n, n, dimnames = list(variables, variables))

for (i in 1:n) {
  for (j in 1:n) {
    if (i != j) {  # Avoid testing a variable against itself
      p_matrix[i, j] <- harvey_collier_test(data, variables[i], variables[j])
    }
  }
}

library(ggplot2)

p_matrix_long <- melt(p_matrix)
names(p_matrix_long) <- c("Var1", "Var2", "p_value")

p_matrix_long$Var1 <- factor(p_matrix_long$Var1, levels = rev(unique(p_matrix_long$Var1)))

alpha = 0.0001

gradient_fill <- scale_fill_gradientn(
  colors = c("#215B9D", "#F0F0F0", "#F0F0F0"),
  values = scales::rescale(c(0, alpha, 1)),
  na.value = "#F0F0F0",  # Also set missing values to light grey
  guide = "colourbar"
)

ggplot(p_matrix_long, aes(Var1, Var2, fill= p_value)) + 
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2e", p_value)), color = "black", size = 2) + 
  gradient_fill +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),
        axis.text.y = element_text(size = 10),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.position = "none") + 
  labs(title = "Heatmap of P-Values") 

Check Assumptions: Linarity Analysis (continued)

• The residual plot for a single pair that was flagged as nonlinear reveals why the Harvey-Collier Test declared nonlinearity.
  
• Transformations may risk altering other variable relationships, so no transformations were applied, acknowledging some information loss in PCA.

data_residual <- as.data.frame(data)

data_residual$residuals <- residuals(lm(Diabetes ~ obesity_age_adj, data = data_residual))

ggplot(data_residual, aes(x = obesity_age_adj, y = residuals)) +
  geom_point() + 
  geom_smooth(method = "loess", se = FALSE, color = "blue") +  # LOWESS curve
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuals of Diabetes vs. obesity_age_adj",
       x = "obesity_age_adj", y = "Residuals") +
  theme_minimal()

Check Assumptions: Outliers Analysis

note: the mean-centering and scaling is handled within the PCA implementation

• Outliers can distort PCA results by disproportionately increasing variance, shifting the direction of principal components, and inflating eigenvalues.
  
• Although PCA does not require normality, a roughly normal distribution minimizes the impact from outliers.
  
• Non-normal data may undergo transformations like the Box-Cox to approximate normality.
  
• Assessing skewness and kurtosis offers practical insights into distribution characteristics.

                   Kurtosis   Skewness
Atrazine_High_KG 866.377802 27.6792372
Mercury_TPY       72.724213  7.4402444
Lead_TPY          34.286296  5.0314443
Cancer             5.489565  0.3562768
Food_index         4.878495 -0.8643685
Heart_Disease      3.867908  0.8405355
Poverty_Percent    3.795263  0.4674652
obesity_age_adj    3.680773  0.2879323
Smoking_Rate       3.531763 -0.7543274
Diabetes           3.344971  0.5427094
SUNLIGHT           2.974585  0.3380277

Check Assumptions: Outliers Analysis (continued)

• The Box-Cox transformation can normalize the data distribution, enhancing its suitability for PCA (“Compression of Spectral Data Using Box-Cox Transformation” 2014).
  
• The transformations create an approximate bell-shaped distribution, reducing outlier effects.
  
• The lambda values indicate minor power adjustments.

                 Lambda
Lead_TPY            0.1
Mercury_TPY        -0.1
Atrazine_High_KG    0.1

Multicollinearity Analysis

library(car)
data_df <-data.frame(data_transform)
model <- lm(Heart_Disease ~ ., data=data_df)

data.frame(VIF=vif(model))

                      VIF
obesity_age_adj  4.321218
Smoking_Rate     1.812287
Diabetes         4.009033
Cancer           1.640111
Mercury_TPY      2.098779
Lead_TPY         2.143279
Food_index       2.159996
Poverty_Percent  2.228750
Atrazine_High_KG 1.085929
SUNLIGHT         1.227205